home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / wildcat / wc30rec.zip / BTREEU.PAS < prev    next >
Pascal/Delphi Source File  |  1992-05-12  |  5KB  |  158 lines
  1.   function SwitchLast(Name : Str25) : Str25;
  2.   var
  3.     X, Y : Byte;
  4.  
  5.   begin
  6.     Y := Length(Name);
  7.     X := Y;
  8.     while (Y > 0) and (Name[Y] <> ' ') do
  9.       Dec(Y);
  10.     if (Y = 0) then
  11.       SwitchLast := Name
  12.     else
  13.       SwitchLast := Copy(Name, Succ(Y), X-Y)+' '+Copy(Name, 1, Pred(Y));
  14.   end;
  15.  
  16.  
  17.   function BuildUserKey(var Data; KeyNr : Byte) : IsamKeyStr;
  18.   var
  19.     UserRec : UserRecordType absolute Data;
  20.  
  21.   begin
  22.     case KeyNr of
  23.       UserNameKey    : BuildUserKey := Pack6BitKeyUC(SwitchLast(UserRec.UserName), 19);
  24.       UserSecKey     : BuildUserKey := Pack6BitKeyUC(UserRec.SecLevel, 8)+Pack6BitKeyUC(SwitchLast(UserRec.UserName), 19);
  25.       UserExpDateKey : BuildUserKey := WordToKey(UserRec.ExpireDate);
  26.       UserAliasKey   : if UserRec.Alias = '' then
  27.                          BuildUserKey := ''
  28.                        else
  29.                          BuildUserKey := Pack6BitKeyUC(UserRec.Alias, 19);
  30.     end;
  31.   end;
  32.  
  33.  
  34.   function AddUserRecord(var UserRec : UserRecordType) : Boolean;
  35.   var
  36.     Key : IsamKeyStr;
  37.     KeyNr : Byte;
  38.     RefNr : LongInt;
  39.     LockStatus : Boolean;
  40.  
  41.   begin
  42.     LockStatus := LockBTree(dbUser);
  43.     FindBtreeKey(UserFile, RefNr, BuildUserKey(UserRec, UserNameKey), UserNameKey);
  44.     if not IsamOk then
  45.       begin
  46.         BtAddRec(UserFile, RefNr, UserRec);
  47.         if not IsamOk then
  48.           LogFatalError('Unable to add user record', IsamError);
  49.         for KeyNr := 1 to KeysDatabase[dbUser] do
  50.           begin
  51.             Key := BuildUserKey(UserRec, KeyNr);
  52.             if Key <> '' then
  53.               begin
  54.                 BtAddKey(UserFile, KeyNr, RefNr, Key);
  55.                 if not IsamOk then
  56.                   LogFatalError('Unable to add user key #'+Long2Str(KeyNr), IsamError);
  57.               end;
  58.           end;
  59.         AddUserRecord := True;
  60.       end
  61.     else
  62.       AddUserRecord := False;
  63.     if LockStatus then
  64.       UnLockBtree(dbUser);
  65.   end;
  66.  
  67.  
  68.   function DeleteUserRecord(var UserRec : UserRecordType) : Boolean;
  69.   var
  70.     Key : IsamKeyStr;
  71.     KeyNr : Byte;
  72.     RefNr : LongInt;
  73.     LockStatus : Boolean;
  74.  
  75.   begin
  76.     LockStatus := LockBTree(dbUser);
  77.     FindBtreeKey(UserFile, RefNr, BuildUserKey(UserRec, UserNameKey), UserNameKey);
  78.     if IsamOk then
  79.       begin
  80.         GetBtreeRec(UserFile, RefNr, UserRec);
  81.         if not IsamOk then
  82.           LogFatalError('Unable to load user record on delete', IsamError);
  83.         for KeyNr := 1 to KeysDatabase[dbUser] do
  84.           begin
  85.             Key := BuildUserKey(UserRec, KeyNr);
  86.             if Key <> '' then
  87.               begin
  88.                 BtDeleteKey(UserFile, KeyNr, RefNr, BuildUserKey(UserRec, KeyNr));
  89.                 if not IsamOk then
  90.                   LogFatalError('Unable to delete user key', IsamError);
  91.               end;
  92.           end;
  93.         BtDeleteRec(UserFile, RefNr);
  94.         if not IsamOK then
  95.           LogFatalError('Unable to delete user record', IsamError);
  96.         DeleteUserRecord := True;
  97.       end
  98.     else
  99.       DeleteUserRecord := False;
  100.     if LockStatus then
  101.       UnLockBtree(dbUser);
  102.   end;
  103.  
  104.  
  105.   function UpdateUserRecord(var UserRec : UserRecordType; PrevName : Str25) : Boolean;
  106.   label
  107.     ExitPoint;
  108.  
  109.   var
  110.     KeyNr : Byte;
  111.     RefNr : LongInt;
  112.     Key : IsamKeyStr;
  113.     LockStatus : Boolean;
  114.     PrevUser : UserRecordType;
  115.  
  116.   begin
  117.     UpdateUserRecord := False;
  118.     PrevUser.UserName := PrevName;
  119.     LockStatus := LockBTree(dbUser);
  120.     if (PrevName <> UserRec.UserName) and UserInDataBase(UserRec.UserName, RefNr) then
  121.       goto ExitPoint;
  122.     FindBtreeKey(UserFile, RefNr, BuildUserKey(PrevUser, UserNameKey), UserNameKey);
  123.     if IsamOk then
  124.       begin
  125.         GetBtreeRec(UserFile, RefNr, PrevUser);
  126.         if not IsamOk then
  127.           LogFatalError('Unable to load user record on update', IsamError);
  128.         for KeyNr := 1 to KeysDatabase[dbUser] do
  129.           begin
  130.             Key := BuildUserKey(PrevUser, KeyNr);
  131.             if (Key <> '') and (Key <> BuildUserKey(UserRec, KeyNr)) then
  132.               begin
  133.                 BtDeleteKey(UserFile, KeyNr, RefNr, Key);
  134.                 if not IsamOk then
  135.                   LogFatalError('Unable to delete user key #'+Long2Str(KeyNr), IsamError);
  136.               end;
  137.           end;
  138.         Move(PrevUser.Confs, UserRec.Confs, SizeOf(ConfUserArray));
  139.         BtPutRec(UserFile, RefNr, UserRec, False);
  140.         if not IsamOk then
  141.           LogFatalError('Unable to update user record', IsamError);
  142.         for KeyNr := 1 to KeysDatabase[dbUser] do
  143.           begin
  144.             Key := BuildUserKey(UserRec, KeyNr);
  145.             if (Key <> '') and (Key <> BuildUserKey(PrevUser, KeyNr)) then
  146.               begin
  147.                 BtAddKey(UserFile, KeyNr, RefNr, Key);
  148.                 if not IsamOK then
  149.                   LogFatalError('Unable to add user key', IsamError);
  150.               end;
  151.           end;
  152.         UpdateUserRecord := True;
  153.       end;
  154.   ExitPoint:
  155.     if LockStatus then
  156.       UnLockBtree(dbUser);
  157.   end;
  158.